home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / RXUnderKey.f < prev    next >
Encoding:
FORTH Source  |  1992-01-26  |  2.5 KB  |  125 lines
  1. \ Wedge ARexx listening under KEY
  2. \
  3. \ Author: Phil Burk & Mike Haas
  4. \ Copyright 1991 Delta Research
  5. \ All Rights Reserved.
  6. \
  7. \ 00001 PLB 9/23/91 Replace Delay() with ?TERMINAL.DELAY
  8. \    because Delay() is buggy and can cause errors on floppies.
  9. \ 00002 PLB 12/4/91 Change TRX. prefix to RXUK.
  10. \     Change to use ARexxTools
  11. \ 00003 MDH 26-jan-92 Add TYPE of strings to be INTERPRETed
  12. \                     cleaned up messages
  13.  
  14. include? task-ARexxTools.f jrx:ARexxTools.f
  15.  
  16. ANEW TASK-RXUnderKey.f
  17.  
  18. defer RXUK.OLD.KEY
  19. defer RXUK.OLD.QUIT
  20.  
  21. variable RXUK-RMPTR
  22.  
  23. : RXUK.QUIT ( -- )
  24.   #tib off  >in off skip-word? off
  25.   rxuk-rmptr @ ?dup
  26.   IF
  27.      >newline  
  28.      dup .. rm_args @ >rel 0count  ascii ' emit  type  ascii ' emit
  29. \ send error message back
  30.      10 rx-result1 !
  31.      rxuk-rmptr @ rx.reply.msg
  32.      rxuk-rmptr off
  33.      ."  from AREXX caused an ABORT" cr
  34.   THEN
  35.   rxuk.old.quit
  36. ;
  37.  
  38. variable rxuk-INSTALLED \ true if installed
  39.  
  40. : RX.DEINSTALL
  41.     rxuk-installed @
  42.     IF
  43.         what's rxuk.old.key is key
  44.         what's rxuk.old.quit is quit
  45.         rx.term
  46.         rxuk-installed off
  47.         >newline ." JForth no longer listening to AREXX." cr
  48.     THEN
  49. ;
  50.  
  51.  
  52. : RXUK.INTERPRET ( -- got-one? )
  53.     ' noop is RX.AFTER.INTERPRET
  54.     rx.get.msg ?dup
  55.     IF
  56.         rxuk-rmptr !  \ don't wait
  57.         rxuk-rmptr @ .. rm_args @ >rel
  58.         0count  >newline ." From AREXX: " 2dup type cr  \ 00003
  59.         $interpret   0 clinenum !
  60.         rxuk-rmptr @ rx.reply.msg  rxuk-rmptr off
  61.         RX.AFTER.INTERPRET  flushemit
  62.         true \ got one!
  63.     ELSE
  64.         false
  65.     THEN
  66. ;
  67.  
  68. : RXUK.INTERP.LOOP ( -- quit? , loop as long as we get messages )
  69.     RX-QUIT off   skip-word? off
  70.        BEGIN
  71.            rxuk.interpret ( -- got-one? ) NOT
  72.            RX-QUIT @ OR
  73.        UNTIL
  74.        rx-quit @
  75. ;
  76.  
  77. variable rxuk-DELAY
  78. 200,000 rxuk-delay ! \ 1/5 second
  79.  
  80. : RXUK.KEY  ( -- char ,listen to Textra and wait for char )
  81.     flushemit
  82.     BEGIN
  83.         rxuk-delay @ ?terminal.delay not
  84.     WHILE
  85.         rxuk.interp.loop
  86.         IF
  87.             rx.deinstall
  88.         THEN
  89.     REPEAT
  90.     rxuk.old.key
  91. ;
  92.  
  93. : RX.INSTALL ( -- )
  94.     rxuk-installed @ 0=
  95.     IF
  96.         jforth_name rx.init 0=
  97.         IF
  98.             what's key is rxuk.old.key
  99.             ' rxuk.key is key
  100.             what's quit is rxuk.old.quit
  101.             ' rxuk.quit is quit
  102.             rxuk-installed on
  103.             >newline ." JForth listening to ARexx!" cr
  104.         ELSE
  105.             >newline  ( 00003 )
  106.             ." ARexx interface could not be initialized!" cr
  107.         THEN
  108.     ELSE
  109.         >newline ." ARexx interface already installed!" cr  ( 00003 )
  110.     THEN
  111. ;
  112.  
  113. if.forgotten rx.deinstall
  114.  
  115. : AUTO.INIT  auto.init rx.install
  116. ;
  117. : AUTO.TERM  rx.deinstall auto.term ;
  118.  
  119. cr
  120. ." To install ARexx listener under KEY, enter:" cr
  121. ."    RX.INSTALL" cr
  122. ." When done, enter:" cr
  123. ."    RX.DEINSTALL" cr
  124.  
  125.